APIM - Control
Pascal Küng, MSc, Patrick Höhener, MSc, James M. Allen, PhD, Robert Tobias, PhD, Urte Scholz, PhD
2024-09-29
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(R.utils)
library(wbCorr)
library(readxl)
library(kableExtra)
library(brms)
library(bayesplot)
library(beepr)
source(file.path('Functions', 'ReportModels.R'))
source(file.path('Functions', 'PrettyTables.R'))
source(file.path('Functions', 'ReportMeasures.R'))
source(file.path('Functions', 'PrepareData.R'))## [1] 1116# Set options for analysis
use_mi = FALSE
shutdown = FALSE
report_ordinal = FALSE
options(
dplyr.print_max = 100,
brms.backend = 'cmdstan',
brms.file_refit = ifelse(use_mi, 'never', 'on_change'),
error = function() beepr::beep(sound = 5)
)df <- openxlsx::read.xlsx(file.path('long.xlsx'))
df_original <- df
# Importantly, we do not recode pushing here.
df_double <- prepare_data(df, recode_pushing = FALSE, use_mi = use_mi)[[1]]Constructing scales reshaping data (4field) centering data within and between
Modelling
# For indistinguishable Dyads
model_rows_fixed <- c(
'Intercept',
# '-- WITHIN PERSON MAIN EFFECTS --',
'persuasion_self_cw',
'persuasion_partner_cw',
'pressure_self_cw',
'pressure_partner_cw',
'pushing_self_cw',
'pushing_partner_cw',
'day',
'weartime_self_cw',
# '-- BETWEEN PERSON MAIN EFFECTS',
'persuasion_self_cb',
'persuasion_partner_cb',
'pressure_self_cb',
'pressure_partner_cb',
'pushing_self_cb',
'pushing_partner_cb',
'weartime_self_cb'
)
model_rows_fixed_ordinal <- c(
model_rows_fixed[1],
'Intercept[1]',
'Intercept[2]',
'Intercept[3]',
'Intercept[4]',
'Intercept[5]',
model_rows_fixed[2:length(model_rows_fixed)]
)
model_rows_random <- c(
# '--------------',
# '-- RANDOM EFFECTS --',
'sd(Intercept)',
'sd(persuasion_self_cw)',
'sd(persuasion_partner_cw)',
'sd(pressure_self_cw)',
'sd(pressure_partner_cw)',
'sd(pushing_self_cw)',
'sd(pushing_partner_cw)',
# '-- CORRELATION STRUCTURE -- ',
'ar[1]',
'nu',
'shape',
'sderr',
'sigma'
)
model_rows_random_ordinal <- c(model_rows_random,'disc')# For indistinguishable Dyads
model_rownames_fixed <- c(
'Intercept',
# '-- WITHIN PERSON MAIN EFFECTS --',
'Daily perceived persuasion target -> target',
'Daily perceived persuasion target -> agent',
'Daily perceived pressure target -> target',
'Daily perceived pressure target -> agent',
'Daily perceived pushing target -> target',
'Daily perceived pushing target -> agent',
'Day',
'Daily weartime',
# '-- BETWEEN PERSON MAIN EFFECTS',
'Mean perceived persuasion target -> target',
'Mean Perceived persuasion target -> agent',
'Mean Perceived pressure target -> target',
'Mean Perceived pressure target -> agent',
'Mean Perceived pushing target -> target',
'Mean Perceived pushing target -> agent',
'Mean weartime'
)
model_rownames_fixed_ordinal <- c(
model_rownames_fixed[1],
'Intercept[1]',
'Intercept[2]',
'Intercept[3]',
'Intercept[4]',
'Intercept[5]',
model_rownames_fixed[2:length(model_rownames_fixed)]
)
model_rownames_random <- c(
# '--------------',
# '-- RANDOM EFFECTS --',
'sd(Intercept)',
'sd(Daily perceived persuasion target -> target)',
'sd(Daily perceived persuasion target -> agent)',
'sd(Daily perceived pressure target -> target)',
'sd(Daily perceived pressure target -> agent)',
'sd(Daily perceived pushing target -> target)',
'sd(Daily perceived pushing target -> agent)',
# '-- CORRELATION STRUCTURE -- ',
'ar[1]',
'nu',
'shape',
'sderr',
'sigma'
)
model_rownames_random_ordinal <- c(model_rownames_random,'disc')rows_to_pack <- list(
"Within-Person Effects" = c(2,9),
"Between-Person Effects" = c(10,16),
"Random Effects" = c(17, 23),
"Additional Parameters" = c(24,28)
)
rows_to_pack_ordinal <- list(
"Intercepts" = c(1,6),
"Within-Person Effects" = c(2+5,9+5),
"Between-Person Effects" = c(10+5,16+5),
"Random Effects" = c(17+5, 23+5),
"Additional Parameters" = c(24+5,28+6)
)Modelling without Pushing
Subjective MVPA
## [1] 0 720
Modelling using the gaussian family fails. Due to the many zeros, transformations won’t help estimating the models. We employ the negative binomial family.
formula <- bf(
pa_sub ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 2.5)", class = "b"),
brms::set_prior("normal(0, 50)", class = "Intercept", lb = 0),
brms::set_prior("normal(0, 10)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 20)", class = "shape"),
brms::set_prior("cauchy(0, 10)", class='sderr')
)
#df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
pa_sub <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = brms::negbinomial(),
#control = list(adapt_delta = 0.99),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_pa_sub")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 3736 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -12068.3 177.4
## p_loo 32.7 2.7
## looic 24136.6 354.8
## ------
## MCSE of elpd_loo is NA.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.5, 2.1]).
##
## Pareto k diagnostic values:
## Count Pct. Min. ESS
## (-Inf, 0.7] (good) 3735 100.0% 789
## (0.7, 1] (bad) 1 0.0% <NA>
## (1, Inf) (very bad) 0 0.0% <NA>
## See help('pareto-k-diagnostic') for details.
summarize_brms(
pa_sub,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| IRR | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 28.10* | 20.03 | 39.77 | 1.001 | 2056.72 | 3805.99 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 0.99 | 0.90 | 1.10 | 1.000 | 15871.93 | 9368.73 |
| Daily perceived persuasion target -> agent | 0.95 | 0.86 | 1.05 | 1.000 | 18083.32 | 9260.25 |
| Daily perceived pressure target -> target | 1.03 | 0.78 | 1.40 | 1.002 | 16850.16 | 9194.69 |
| Daily perceived pressure target -> agent | 0.67* | 0.54 | 0.87 | 1.000 | 16608.30 | 9205.21 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | 1.10 | 0.80 | 1.51 | 1.001 | 17953.58 | 8862.64 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | 0.91 | 0.57 | 1.45 | 1.000 | 7586.01 | 8483.25 |
| Mean Perceived persuasion target -> agent | 0.97 | 0.59 | 1.60 | 1.000 | 8080.27 | 9304.16 |
| Mean Perceived pressure target -> target | 1.69 | 0.88 | 3.19 | 1.001 | 9387.45 | 9113.04 |
| Mean Perceived pressure target -> agent | 0.63 | 0.31 | 1.27 | 1.000 | 8254.82 | 8948.56 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.68 | 0.50 | 0.93 | 1.00 | 3115.16 | 5380.10 |
| sd(Daily perceived persuasion target -> target) | 0.22 | 0.09 | 0.38 | 1.00 | 4103.59 | 3884.88 |
| sd(Daily perceived persuasion target -> agent) | 0.22 | 0.09 | 0.38 | 1.00 | 4910.84 | 5925.79 |
| sd(Daily perceived pressure target -> target) | 0.14 | 0.01 | 0.43 | 1.00 | 8508.21 | 6197.41 |
| sd(Daily perceived pressure target -> agent) | 0.14 | 0.00 | 0.44 | 1.00 | 7875.25 | 6273.46 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.01 | -0.94 | 0.93 | 1.00 | 15002.20 | 7570.30 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | 0.14 | 0.13 | 0.14 | 1.00 | 15053.07 | 7837.09 |
| sderr | 0.05 | 0.00 | 0.13 | 1.00 | 6904.67 | 5589.30 |
| sigma | NA | NA | NA | NA | NA | NA |
Device Based MVPA
## [1] 5.75 971.25
We tried negative binomial here as well for consistency, but the model did not converge. Poisson also did not work. As we have no zeros in this distribution, we log transform.
formula <- bf(
pa_obj_log ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day + weartime_self_cw + weartime_self_cb +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 2.5)", class = "b"),
brms::set_prior("normal(0, 50)", class = "Intercept", lb = 0),
brms::set_prior("normal(0, 10)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
#df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
pa_obj_log <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.99),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_pa_obj_log")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 3337 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -2810.4 55.4
## p_loo 80.5 3.5
## looic 5620.8 110.8
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 2.2]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
pa_obj_log,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| exp(Est.) | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 118.31* | 106.92 | 130.46 | 1.000 | 3972.26 | 5568.28 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 1.00 | 0.98 | 1.02 | 1.000 | 24728.19 | 8937.79 |
| Daily perceived persuasion target -> agent | 1.02* | 1.00 | 1.04 | 1.000 | 26226.98 | 8480.09 |
| Daily perceived pressure target -> target | 0.99 | 0.94 | 1.04 | 1.001 | 27281.68 | 8597.87 |
| Daily perceived pressure target -> agent | 1.00 | 0.95 | 1.06 | 1.001 | 26838.60 | 8499.85 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | 1.00 | 0.92 | 1.08 | 1.001 | 26535.67 | 9547.84 |
| Daily weartime | 1.00 | 1.00 | 1.00 | 1.000 | 11952.82 | 7492.99 |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | 0.92 | 0.79 | 1.06 | 1.000 | 9613.68 | 9735.49 |
| Mean Perceived persuasion target -> agent | 1.17* | 1.01 | 1.35 | 1.000 | 10135.30 | 9622.03 |
| Mean Perceived pressure target -> target | 1.06 | 0.86 | 1.30 | 1.000 | 14493.29 | 10502.64 |
| Mean Perceived pressure target -> agent | 0.77* | 0.64 | 0.93 | 1.000 | 13676.12 | 9789.08 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | 1.00* | 1.00 | 1.00 | 1.000 | 13787.13 | 11210.77 |
| Random Effects | ||||||
| sd(Intercept) | 0.26 | 0.20 | 0.34 | 1.00 | 3851.33 | 6904.40 |
| sd(Daily perceived persuasion target -> target) | 0.06 | 0.04 | 0.09 | 1.00 | 8391.11 | 9151.87 |
| sd(Daily perceived persuasion target -> agent) | 0.05 | 0.03 | 0.08 | 1.00 | 7313.58 | 7050.73 |
| sd(Daily perceived pressure target -> target) | 0.06 | 0.00 | 0.16 | 1.00 | 5135.19 | 6167.69 |
| sd(Daily perceived pressure target -> agent) | 0.04 | 0.00 | 0.10 | 1.00 | 8183.95 | 7465.79 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.28 | 0.24 | 0.31 | 1.00 | 22710.99 | 8537.39 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.55 | 0.54 | 0.57 | 1.00 | 25400.77 | 9218.73 |
Affect
## [1] 1 6
formula <- bf(
aff ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=6), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
mood <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_mood")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 3736 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -4825.2 63.6
## p_loo 78.3 3.9
## looic 9650.5 127.2
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.5, 2.2]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
mood,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = F) %>%
print_df(rows_to_pack = rows_to_pack)| b | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 4.89* | 4.67 | 5.10 | 1.001 | 2140.11 | 3736.15 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 0.01 | -0.02 | 0.04 | 1.001 | 24997.61 | 9213.60 |
| Daily perceived persuasion target -> agent | -0.02 | -0.05 | 0.00 | 1.001 | 23017.48 | 8404.89 |
| Daily perceived pressure target -> target | -0.05 | -0.13 | 0.02 | 1.001 | 24282.52 | 9203.83 |
| Daily perceived pressure target -> agent | 0.04 | -0.03 | 0.12 | 1.000 | 22301.17 | 9009.83 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | -0.08 | -0.23 | 0.07 | 1.001 | 25958.60 | 8222.84 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | 0.12 | -0.15 | 0.40 | 1.000 | 7278.72 | 8590.82 |
| Mean Perceived persuasion target -> agent | -0.02 | -0.29 | 0.26 | 1.000 | 8137.35 | 9318.16 |
| Mean Perceived pressure target -> target | -0.04 | -0.37 | 0.29 | 1.000 | 11206.69 | 8918.29 |
| Mean Perceived pressure target -> agent | 0.00 | -0.36 | 0.36 | 1.000 | 9849.77 | 9692.76 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.62 | 0.48 | 0.81 | 1.00 | 2779.88 | 5445.21 |
| sd(Daily perceived persuasion target -> target) | 0.03 | 0.00 | 0.07 | 1.00 | 5426.99 | 6735.31 |
| sd(Daily perceived persuasion target -> agent) | 0.06 | 0.01 | 0.12 | 1.00 | 3385.00 | 3516.31 |
| sd(Daily perceived pressure target -> target) | 0.10 | 0.00 | 0.26 | 1.00 | 3706.73 | 5953.75 |
| sd(Daily perceived pressure target -> agent) | 0.13 | 0.01 | 0.31 | 1.00 | 3822.49 | 5393.47 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.45 | 0.42 | 0.48 | 1.00 | 21975.53 | 8954.49 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.87 | 0.85 | 0.89 | 1.00 | 21809.43 | 8856.58 |
reactance
## [1] 0 5
formula <- bf(
reactance ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=5), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
reactance <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_reactance")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 756 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -1071.6 33.9
## p_loo 71.9 7.0
## looic 2143.3 67.8
## ------
## MCSE of elpd_loo is NA.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 1.8]).
##
## Pareto k diagnostic values:
## Count Pct. Min. ESS
## (-Inf, 0.7] (good) 748 98.9% 212
## (0.7, 1] (bad) 8 1.1% <NA>
## (1, Inf) (very bad) 0 0.0% <NA>
## See help('pareto-k-diagnostic') for details.
## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: reactance ~ persuasion_self_cw + persuasion_partner_cw + pressure_self_cw + pressure_partner_cw + persuasion_self_cb + persuasion_partner_cb + pressure_self_cb + pressure_partner_cb + day + (persuasion_self_cw + persuasion_partner_cw + pressure_self_cw + pressure_partner_cw | coupleID)
## autocor ~ ar(time = day, gr = coupleID:userID, p = 1)
## Data: data (Number of observations: 756)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Correlation Structures:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## ar[1] 0.01 0.04 -0.07 0.10 1.00 14013 9330
##
## Multilevel Hyperparameters:
## ~coupleID (Number of levels: 38)
## Estimate Est.Error l-95% CI
## sd(Intercept) 0.57 0.08 0.43
## sd(persuasion_self_cw) 0.06 0.04 0.00
## sd(persuasion_partner_cw) 0.04 0.03 0.00
## sd(pressure_self_cw) 0.43 0.10 0.27
## sd(pressure_partner_cw) 0.18 0.14 0.01
## cor(Intercept,persuasion_self_cw) -0.20 0.35 -0.77
## cor(Intercept,persuasion_partner_cw) 0.08 0.38 -0.66
## cor(persuasion_self_cw,persuasion_partner_cw) -0.02 0.41 -0.76
## cor(Intercept,pressure_self_cw) 0.31 0.21 -0.12
## cor(persuasion_self_cw,pressure_self_cw) -0.19 0.37 -0.82
## cor(persuasion_partner_cw,pressure_self_cw) -0.03 0.40 -0.76
## cor(Intercept,pressure_partner_cw) 0.23 0.29 -0.36
## cor(persuasion_self_cw,pressure_partner_cw) 0.04 0.41 -0.74
## cor(persuasion_partner_cw,pressure_partner_cw) -0.02 0.41 -0.77
## cor(pressure_self_cw,pressure_partner_cw) -0.02 0.36 -0.66
## u-95% CI Rhat Bulk_ESS
## sd(Intercept) 0.75 1.00 4741
## sd(persuasion_self_cw) 0.15 1.00 2742
## sd(persuasion_partner_cw) 0.11 1.00 7740
## sd(pressure_self_cw) 0.65 1.00 7569
## sd(pressure_partner_cw) 0.55 1.00 3035
## cor(Intercept,persuasion_self_cw) 0.56 1.00 9462
## cor(Intercept,persuasion_partner_cw) 0.75 1.00 17286
## cor(persuasion_self_cw,persuasion_partner_cw) 0.74 1.00 13708
## cor(Intercept,pressure_self_cw) 0.68 1.00 5318
## cor(persuasion_self_cw,pressure_self_cw) 0.59 1.00 2665
## cor(persuasion_partner_cw,pressure_self_cw) 0.73 1.00 2914
## cor(Intercept,pressure_partner_cw) 0.76 1.00 10064
## cor(persuasion_self_cw,pressure_partner_cw) 0.77 1.00 8341
## cor(persuasion_partner_cw,pressure_partner_cw) 0.76 1.00 8150
## cor(pressure_self_cw,pressure_partner_cw) 0.69 1.00 11623
## Tail_ESS
## sd(Intercept) 6627
## sd(persuasion_self_cw) 5539
## sd(persuasion_partner_cw) 6935
## sd(pressure_self_cw) 8921
## sd(pressure_partner_cw) 5393
## cor(Intercept,persuasion_self_cw) 7431
## cor(Intercept,persuasion_partner_cw) 7827
## cor(persuasion_self_cw,persuasion_partner_cw) 9262
## cor(Intercept,pressure_self_cw) 8076
## cor(persuasion_self_cw,pressure_self_cw) 4851
## cor(persuasion_partner_cw,pressure_self_cw) 6372
## cor(Intercept,pressure_partner_cw) 7904
## cor(persuasion_self_cw,pressure_partner_cw) 8974
## cor(persuasion_partner_cw,pressure_partner_cw) 8957
## cor(pressure_self_cw,pressure_partner_cw) 9451
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 0.54 0.13 0.28 0.80 1.00 4421
## persuasion_self_cw 0.03 0.03 -0.02 0.09 1.00 19298
## persuasion_partner_cw -0.00 0.03 -0.06 0.05 1.00 18740
## pressure_self_cw -0.02 0.05 -0.11 0.07 1.00 18455
## pressure_partner_cw -0.01 0.06 -0.14 0.12 1.00 17983
## persuasion_self_cb -0.17 0.17 -0.51 0.17 1.00 8739
## persuasion_partner_cb 0.09 0.18 -0.25 0.45 1.00 10384
## pressure_self_cb 0.15 0.20 -0.25 0.55 1.00 9525
## pressure_partner_cb -0.02 0.22 -0.45 0.41 1.00 10991
## day -0.15 0.14 -0.42 0.12 1.00 18398
## Tail_ESS
## Intercept 5495
## persuasion_self_cw 9984
## persuasion_partner_cw 10085
## pressure_self_cw 9146
## pressure_partner_cw 9492
## persuasion_self_cb 9673
## persuasion_partner_cb 9967
## pressure_self_cb 9336
## pressure_partner_cb 9135
## day 9271
##
## Further Distributional Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.95 0.03 0.90 1.00 1.00 13659 9488
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).summarize_brms(
reactance,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = F) %>%
print_df(rows_to_pack = rows_to_pack)| b | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 0.54* | 0.28 | 0.80 | 1.001 | 4421.15 | 5495.29 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 0.03 | -0.02 | 0.09 | 1.000 | 19297.77 | 9984.41 |
| Daily perceived persuasion target -> agent | 0.00 | -0.06 | 0.05 | 1.000 | 18739.80 | 10085.31 |
| Daily perceived pressure target -> target | -0.02 | -0.11 | 0.07 | 1.000 | 18454.70 | 9145.87 |
| Daily perceived pressure target -> agent | -0.01 | -0.14 | 0.12 | 1.000 | 17982.95 | 9491.53 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | -0.15 | -0.42 | 0.12 | 1.001 | 18397.58 | 9271.26 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | -0.17 | -0.51 | 0.17 | 1.000 | 8739.13 | 9672.76 |
| Mean Perceived persuasion target -> agent | 0.09 | -0.25 | 0.45 | 1.000 | 10383.66 | 9967.35 |
| Mean Perceived pressure target -> target | 0.15 | -0.25 | 0.55 | 1.000 | 9524.82 | 9336.11 |
| Mean Perceived pressure target -> agent | -0.02 | -0.45 | 0.41 | 1.000 | 10991.31 | 9134.64 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.57 | 0.43 | 0.75 | 1.00 | 4740.74 | 6626.58 |
| sd(Daily perceived persuasion target -> target) | 0.06 | 0.00 | 0.15 | 1.00 | 2742.01 | 5538.67 |
| sd(Daily perceived persuasion target -> agent) | 0.04 | 0.00 | 0.11 | 1.00 | 7739.93 | 6934.68 |
| sd(Daily perceived pressure target -> target) | 0.43 | 0.27 | 0.65 | 1.00 | 7569.39 | 8921.38 |
| sd(Daily perceived pressure target -> agent) | 0.18 | 0.01 | 0.55 | 1.00 | 3034.88 | 5393.33 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.01 | -0.07 | 0.10 | 1.00 | 14013.20 | 9329.56 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.95 | 0.90 | 1.00 | 1.00 | 13658.81 | 9488.49 |
Binary Version
introduce_binary_reactance <- function(data) {
data$is_reactance <- factor(data$reactance > 0, levels = c(FALSE, TRUE), labels = c(0, 1))
return(data)
}
df_double <- introduce_binary_reactance(df_double)
if (use_mi) {
for (i in seq_along(implist)) {
implist[[i]] <- introduce_binary_reactance(implist[[i]])
}
}
formula <- bf(
is_reactance ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=5), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1)
#brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
is_reactance <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = bernoulli(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_is_reactance")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 756 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -399.6 14.7
## p_loo 331.5 12.8
## looic 799.2 29.3
## ------
## MCSE of elpd_loo is NA.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.7, 1.2]).
##
## Pareto k diagnostic values:
## Count Pct. Min. ESS
## (-Inf, 0.7] (good) 13 1.7% 472
## (0.7, 1] (bad) 478 63.2% <NA>
## (1, Inf) (very bad) 265 35.1% <NA>
## See help('pareto-k-diagnostic') for details.
summarize_brms(
is_reactance,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| OR | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 1.18 | 0.21 | 6.85 | 1.000 | 7551.85 | 8513.81 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 1.40 | 0.81 | 2.69 | 1.000 | 6368.39 | 7072.08 |
| Daily perceived persuasion target -> agent | 0.96 | 0.48 | 1.87 | 1.000 | 8139.26 | 7943.36 |
| Daily perceived pressure target -> target | 1.09 | 0.38 | 3.19 | 1.001 | 7260.91 | 7680.44 |
| Daily perceived pressure target -> agent | 0.79 | 0.18 | 3.31 | 1.001 | 6880.54 | 8536.38 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | 0.41 | 0.02 | 7.67 | 1.001 | 7566.96 | 7295.50 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | 0.32 | 0.01 | 11.03 | 1.000 | 7109.68 | 7481.25 |
| Mean Perceived persuasion target -> agent | 2.68 | 0.10 | 87.95 | 1.000 | 5521.01 | 6175.84 |
| Mean Perceived pressure target -> target | 2.75 | 0.05 | 128.33 | 1.000 | 7116.53 | 7219.64 |
| Mean Perceived pressure target -> agent | 0.83 | 0.01 | 51.67 | 1.000 | 6084.80 | 6859.66 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 5.63 | 3.44 | 8.14 | 1.00 | 3080.03 | 3195.89 |
| sd(Daily perceived persuasion target -> target) | 1.04 | 0.11 | 2.31 | 1.00 | 1995.34 | 3383.37 |
| sd(Daily perceived persuasion target -> agent) | 1.02 | 0.06 | 2.42 | 1.00 | 2614.14 | 4545.39 |
| sd(Daily perceived pressure target -> target) | 2.86 | 1.25 | 5.00 | 1.00 | 4339.19 | 6146.98 |
| sd(Daily perceived pressure target -> agent) | 1.13 | 0.04 | 3.34 | 1.00 | 4968.27 | 7181.71 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.12 | -0.07 | 0.33 | 1.00 | 2632.61 | 4097.54 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | 6.56 | 3.50 | 10.45 | 1.00 | 2073.87 | 2461.71 |
| sigma | NA | NA | NA | NA | NA | NA |
Report All Models without Pushing
if (report_ordinal) {
model_rows_random_final <- model_rows_random_ordinal
model_rows_fixed_final <- model_rows_fixed_ordinal
model_rownames_fixed_final <- model_rownames_fixed_ordinal
model_rownames_random_final <- model_rownames_random_ordinal
rows_to_pack_final <- rows_to_pack_ordinal
} else {
model_rows_random_final <- model_rows_random
model_rows_fixed_final <- model_rows_fixed
model_rownames_fixed_final <- model_rownames_fixed
model_rownames_random_final <- model_rownames_random
rows_to_pack_final <- rows_to_pack
}
all_models <- report_side_by_side(
pa_sub,
pa_obj_log,
mood,
reactance,
is_reactance,
model_rows_random = model_rows_random_final,
model_rows_fixed = model_rows_fixed_final,
model_rownames_random = model_rownames_random_final,
model_rownames_fixed = model_rownames_fixed_final
) ## [1] "pa_sub"
## [1] "pa_obj_log"## [1] "mood"
## [1] "reactance"## [1] "is_reactance"# pretty printing
summary_all_models <- all_models %>%
print_df(rows_to_pack = rows_to_pack_final) %>%
add_header_above(
c(" ", "Subjective MVPA" = 2,
"Device-Based MVPA" = 2,
"Mood" = 2,
"Reactance Gaussian" = 2,
"Reactance Dichotome" = 2)
)
export_xlsx(summary_all_models,
rows_to_pack = rows_to_pack_final,
file.path("Output", "SensitivityExcludePushing", "AllModels_noPushing.xlsx"),
merge_option = 'both',
simplify_2nd_row = TRUE,
colwidths = c(40, 7.4, 12.85, 7.4, 12.85,7.4, 12.85,7.4, 12.85,7.4, 12.85),
line_above_rows = c(1,2,3,21),
line_below_rows = c(-1))
summary_all_models| IRR pa_sub | 95% CI pa_sub | exp(Est.) pa_obj_log | 95% CI pa_obj_log | b mood | 95% CI mood | b reactance | 95% CI reactance | OR is_reactance | 95% CI is_reactance | |
|---|---|---|---|---|---|---|---|---|---|---|
| Intercept | 28.10* | [20.03, 39.77] | 118.31* | [106.92, 130.46] | 4.89* | [ 4.67, 5.10] | 0.54* | [ 0.28, 0.80] | 1.18 | [0.21, 6.85] |
| Within-Person Effects | ||||||||||
| Daily perceived persuasion target -> target | 0.99 | [ 0.90, 1.10] | 1.00 | [ 0.98, 1.02] | 0.01 | [-0.02, 0.04] | 0.03 | [-0.02, 0.09] | 1.40 | [0.81, 2.69] |
| Daily perceived persuasion target -> agent | 0.95 | [ 0.86, 1.05] | 1.02* | [ 1.00, 1.04] | -0.02 | [-0.05, 0.00] | 0.00 | [-0.06, 0.05] | 0.96 | [0.48, 1.87] |
| Daily perceived pressure target -> target | 1.03 | [ 0.78, 1.40] | 0.99 | [ 0.94, 1.04] | -0.05 | [-0.13, 0.02] | -0.02 | [-0.11, 0.07] | 1.09 | [0.38, 3.19] |
| Daily perceived pressure target -> agent | 0.67* | [ 0.54, 0.87] | 1.00 | [ 0.95, 1.06] | 0.04 | [-0.03, 0.12] | -0.01 | [-0.14, 0.12] | 0.79 | [0.18, 3.31] |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Day | 1.10 | [ 0.80, 1.51] | 1.00 | [ 0.92, 1.08] | -0.08 | [-0.23, 0.07] | -0.15 | [-0.42, 0.12] | 0.41 | [0.02, 7.67] |
| Daily weartime | NA | NA | 1.00 | [ 1.00, 1.00] | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||||||
| Mean perceived persuasion target -> target | 0.91 | [ 0.57, 1.45] | 0.92 | [ 0.79, 1.06] | 0.12 | [-0.15, 0.40] | -0.17 | [-0.51, 0.17] | 0.32 | [0.01, 11.03] |
| Mean Perceived persuasion target -> agent | 0.97 | [ 0.59, 1.60] | 1.17* | [ 1.01, 1.35] | -0.02 | [-0.29, 0.26] | 0.09 | [-0.25, 0.45] | 2.68 | [0.10, 87.95] |
| Mean Perceived pressure target -> target | 1.69 | [ 0.88, 3.19] | 1.06 | [ 0.86, 1.30] | -0.04 | [-0.37, 0.29] | 0.15 | [-0.25, 0.55] | 2.75 | [0.05, 128.33] |
| Mean Perceived pressure target -> agent | 0.63 | [ 0.31, 1.27] | 0.77* | [ 0.64, 0.93] | 0.00 | [-0.36, 0.36] | -0.02 | [-0.45, 0.41] | 0.83 | [0.01, 51.67] |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | 1.00* | [ 1.00, 1.00] | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||||||
| sd(Intercept) | 0.68 | [ 0.50, 0.93] | 0.26 | [0.20, 0.34] | 0.62 | [0.48, 0.81] | 0.57 | [ 0.43, 0.75] | 5.63 | [ 3.44, 8.14] |
| sd(Daily perceived persuasion target -> target) | 0.22 | [ 0.09, 0.38] | 0.06 | [0.04, 0.09] | 0.03 | [0.00, 0.07] | 0.06 | [ 0.00, 0.15] | 1.04 | [ 0.11, 2.31] |
| sd(Daily perceived persuasion target -> agent) | 0.22 | [ 0.09, 0.38] | 0.05 | [0.03, 0.08] | 0.06 | [0.01, 0.12] | 0.04 | [ 0.00, 0.11] | 1.02 | [ 0.06, 2.42] |
| sd(Daily perceived pressure target -> target) | 0.14 | [ 0.01, 0.43] | 0.06 | [0.00, 0.16] | 0.10 | [0.00, 0.26] | 0.43 | [ 0.27, 0.65] | 2.86 | [ 1.25, 5.00] |
| sd(Daily perceived pressure target -> agent) | 0.14 | [ 0.00, 0.44] | 0.04 | [0.00, 0.10] | 0.13 | [0.01, 0.31] | 0.18 | [ 0.01, 0.55] | 1.13 | [ 0.04, 3.34] |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||||||
| ar[1] | 0.01 | [-0.94, 0.93] | 0.28 | [0.24, 0.31] | 0.45 | [0.42, 0.48] | 0.01 | [-0.07, 0.10] | 0.12 | [-0.07, 0.33] |
| nu | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| shape | 0.14 | [ 0.13, 0.14] | NA | NA | NA | NA | NA | NA | NA | NA |
| sderr | 0.05 | [ 0.00, 0.13] | NA | NA | NA | NA | NA | NA | 6.56 | [ 3.50, 10.45] |
| sigma | NA | NA | 0.55 | [0.54, 0.57] | 0.87 | [0.85, 0.89] | 0.95 | [ 0.90, 1.00] | NA | NA |
Modelling ONLY Pushing
Without recoding NAs.
Subjective MVPA
formula <- bf(
pa_sub ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day +
# Random effects
(pushing_self_cw + pushing_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 2.5)", class = "b"),
brms::set_prior("normal(0, 50)", class = "Intercept", lb = 0),
brms::set_prior("normal(0, 10)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 20)", class = "shape"),
brms::set_prior("cauchy(0, 10)", class='sderr')
)
#df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
pa_sub <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = brms::negbinomial(),
#control = list(adapt_delta = 0.99),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_pa_sub_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 1342 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -6339.2 67.2
## p_loo 28.6 2.3
## looic 12678.4 134.4
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 1.9]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
pa_sub,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| IRR | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 48.47* | 36.29 | 64.44 | 1.000 | 6030.65 | 8260.33 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 0.99 | 0.90 | 1.10 | 1.000 | 25004.06 | 8925.50 |
| Daily perceived pushing target -> agent | 1.00 | 0.90 | 1.11 | 1.001 | 23908.50 | 8650.33 |
| Day | 0.93 | 0.69 | 1.25 | 1.000 | 19372.58 | 9296.92 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.92 | 0.71 | 1.21 | 1.000 | 17478.79 | 10143.81 |
| Mean Perceived pushing target -> agent | 1.20 | 0.93 | 1.57 | 1.001 | 17955.69 | 9691.10 |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.67 | 0.43 | 1.00 | 1.00 | 2872.90 | 5665.49 |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.13 | 0.01 | 0.29 | 1.00 | 3987.26 | 4769.29 |
| sd(Daily perceived pushing target -> agent) | 0.13 | 0.01 | 0.28 | 1.00 | 4672.94 | 5280.96 |
| Additional Parameters | ||||||
| ar[1] | 0.04 | -0.93 | 0.94 | 1.00 | 17901.78 | 8080.61 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | 0.42 | 0.39 | 0.46 | 1.00 | 17243.71 | 8874.26 |
| sderr | 0.05 | 0.00 | 0.13 | 1.00 | 7946.29 | 6915.04 |
| sigma | NA | NA | NA | NA | NA | NA |
Device Based MVPA
formula <- bf(
pa_obj_log ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day + weartime_self_cw + weartime_self_cb +
# Random effects
(pushing_self_cw + pushing_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 2.5)", class = "b"),
brms::set_prior("normal(0, 50)", class = "Intercept", lb = 0),
brms::set_prior("normal(0, 10)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
#df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
pa_obj_log <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.99),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_pa_obj_log_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 1214 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -986.8 33.8
## p_loo 62.5 5.0
## looic 1973.5 67.5
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 1.9]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
pa_obj_log,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| exp(Est.) | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 115.12* | 101.34 | 130.31 | 1.001 | 3049.49 | 5506.43 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 1.00 | 0.96 | 1.03 | 1.000 | 18025.26 | 8306.97 |
| Daily perceived pushing target -> agent | 0.97 | 0.94 | 1.01 | 1.000 | 18819.09 | 8817.05 |
| Day | 1.16* | 1.02 | 1.31 | 1.000 | 16306.41 | 8587.17 |
| Daily weartime | 1.00 | 1.00 | 1.00 | 1.000 | 12235.20 | 7548.45 |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.96 | 0.85 | 1.09 | 1.000 | 11652.80 | 9393.60 |
| Mean Perceived pushing target -> agent | 1.03 | 0.92 | 1.15 | 1.000 | 12681.82 | 10328.48 |
| Mean weartime | 1.00 | 1.00 | 1.00 | 1.001 | 12643.47 | 10751.56 |
| Random Effects | ||||||
| sd(Intercept) | 0.30 | 0.22 | 0.40 | 1.00 | 3739.76 | 6787.89 |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.10 | 0.03 | 0.18 | 1.00 | 3303.42 | 3042.51 |
| sd(Daily perceived pushing target -> agent) | 0.05 | 0.00 | 0.11 | 1.00 | 3043.19 | 4092.34 |
| Additional Parameters | ||||||
| ar[1] | 0.27 | 0.21 | 0.33 | 1.00 | 12999.53 | 9396.74 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.53 | 0.51 | 0.55 | 1.00 | 15302.96 | 8560.42 |
Affect
formula <- bf(
aff ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day +
# Random effects
(pushing_self_cw + pushing_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=6), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
mood <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_mood_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 1342 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -1772.7 41.8
## p_loo 53.5 3.3
## looic 3545.5 83.5
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 1.8]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
mood,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = F) %>%
print_df(rows_to_pack = rows_to_pack)| b | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 4.95* | 4.72 | 5.18 | 1.001 | 1926.68 | 3676.75 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 0.00 | -0.05 | 0.06 | 1.001 | 15673.16 | 9002.89 |
| Daily perceived pushing target -> agent | 0.00 | -0.06 | 0.06 | 1.001 | 13559.72 | 9201.58 |
| Day | 0.07 | -0.13 | 0.27 | 1.000 | 13252.12 | 9388.87 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.03 | -0.15 | 0.23 | 1.000 | 8229.78 | 8885.41 |
| Mean Perceived pushing target -> agent | -0.11 | -0.30 | 0.07 | 1.000 | 9558.67 | 9222.35 |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.61 | 0.47 | 0.80 | 1.00 | 2540.59 | 4733.50 |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.07 | 0.00 | 0.15 | 1.00 | 3531.19 | 2995.94 |
| sd(Daily perceived pushing target -> agent) | 0.12 | 0.03 | 0.23 | 1.00 | 3755.86 | 2791.55 |
| Additional Parameters | ||||||
| ar[1] | 0.27 | 0.22 | 0.33 | 1.00 | 10036.95 | 9148.22 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.89 | 0.85 | 0.92 | 1.00 | 12382.10 | 9048.62 |
reactance
formula <- bf(
reactance ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=5), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
reactance <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_reactance_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 403 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -599.0 24.3
## p_loo 43.1 5.1
## looic 1198.1 48.7
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 1.5]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: reactance ~ pushing_self_cw + pushing_partner_cw + pushing_self_cb + pushing_partner_cb + day + (persuasion_self_cw + persuasion_partner_cw | coupleID)
## autocor ~ ar(time = day, gr = coupleID:userID, p = 1)
## Data: data (Number of observations: 403)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Correlation Structures:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## ar[1] 0.15 0.06 0.03 0.28 1.00 11546 9129
##
## Multilevel Hyperparameters:
## ~coupleID (Number of levels: 37)
## Estimate Est.Error l-95% CI
## sd(Intercept) 0.63 0.14 0.38
## sd(persuasion_self_cw) 0.15 0.07 0.02
## sd(persuasion_partner_cw) 0.08 0.05 0.00
## cor(Intercept,persuasion_self_cw) -0.73 0.30 -0.99
## cor(Intercept,persuasion_partner_cw) 0.26 0.47 -0.76
## cor(persuasion_self_cw,persuasion_partner_cw) -0.26 0.47 -0.93
## u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.93 1.00 2950 5429
## sd(persuasion_self_cw) 0.29 1.00 2643 2944
## sd(persuasion_partner_cw) 0.20 1.00 5570 6575
## cor(Intercept,persuasion_self_cw) 0.18 1.00 3371 5321
## cor(Intercept,persuasion_partner_cw) 0.94 1.00 10831 8468
## cor(persuasion_self_cw,persuasion_partner_cw) 0.77 1.00 9346 9054
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 0.43 0.14 0.15 0.70 1.00 5416
## pushing_self_cw -0.01 0.04 -0.09 0.08 1.00 17971
## pushing_partner_cw 0.14 0.05 0.05 0.24 1.00 18760
## pushing_self_cb 0.01 0.13 -0.24 0.27 1.00 11047
## pushing_partner_cb -0.14 0.13 -0.40 0.11 1.00 10896
## day 0.20 0.20 -0.19 0.59 1.00 15015
## Tail_ESS
## Intercept 7761
## pushing_self_cw 9518
## pushing_partner_cw 8641
## pushing_self_cb 9157
## pushing_partner_cb 7901
## day 9418
##
## Further Distributional Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 1.01 0.04 0.94 1.09 1.00 8747 8748
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).summarize_brms(
reactance,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = F) %>%
print_df(rows_to_pack = rows_to_pack)| b | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 0.43* | 0.15 | 0.70 | 1.001 | 5416.10 | 7761.03 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | -0.01 | -0.09 | 0.08 | 1.000 | 17971.21 | 9517.65 |
| Daily perceived pushing target -> agent | 0.14* | 0.05 | 0.24 | 1.001 | 18760.48 | 8641.32 |
| Day | 0.20 | -0.19 | 0.59 | 1.001 | 15015.04 | 9418.02 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.01 | -0.24 | 0.27 | 1.001 | 11047.44 | 9157.11 |
| Mean Perceived pushing target -> agent | -0.14 | -0.40 | 0.11 | 1.000 | 10895.89 | 7900.70 |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.63 | 0.38 | 0.93 | 1.00 | 2949.98 | 5428.51 |
| sd(Daily perceived persuasion target -> target) | 0.15 | 0.02 | 0.29 | 1.00 | 2643.15 | 2944.10 |
| sd(Daily perceived persuasion target -> agent) | 0.08 | 0.00 | 0.20 | 1.00 | 5570.05 | 6574.76 |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.15 | 0.03 | 0.28 | 1.00 | 11545.72 | 9128.94 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 1.01 | 0.94 | 1.09 | 1.00 | 8746.76 | 8748.18 |
Binary Version
introduce_binary_reactance <- function(data) {
data$is_reactance <- factor(data$reactance > 0, levels = c(FALSE, TRUE), labels = c(0, 1))
return(data)
}
df_double <- introduce_binary_reactance(df_double)
if (use_mi) {
for (i in seq_along(implist)) {
implist[[i]] <- introduce_binary_reactance(implist[[i]])
}
}
formula <- bf(
is_reactance ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day +
# Random effects
(pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=5), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1)
#brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
is_reactance <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = bernoulli(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path("models_cache", "exclude_pushing_is_reactance_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 403 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -431.8 22.2
## p_loo 372.4 20.0
## looic 863.6 44.3
## ------
## MCSE of elpd_loo is NA.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 1.2]).
##
## Pareto k diagnostic values:
## Count Pct. Min. ESS
## (-Inf, 0.7] (good) 12 3.0% 883
## (0.7, 1] (bad) 169 41.9% <NA>
## (1, Inf) (very bad) 222 55.1% <NA>
## See help('pareto-k-diagnostic') for details.
summarize_brms(
is_reactance,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| OR | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 0.68 | 0.15 | 2.84 | 1.000 | 10635.14 | 8257.52 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 0.85 | 0.39 | 1.69 | 1.000 | 9234.25 | 7409.93 |
| Daily perceived pushing target -> agent | 3.09* | 1.39 | 10.11 | 1.001 | 3123.62 | 5632.81 |
| Day | 4.89 | 0.25 | 135.66 | 1.001 | 9375.18 | 8258.36 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.52 | 0.05 | 4.31 | 1.001 | 8672.80 | 7118.76 |
| Mean Perceived pushing target -> agent | 0.46 | 0.04 | 3.70 | 1.000 | 9403.91 | 8005.02 |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 4.64 | 2.45 | 7.31 | 1.00 | 1929.12 | 2676.99 |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.62 | 0.03 | 1.68 | 1.00 | 3586.08 | 6070.11 |
| sd(Daily perceived pushing target -> agent) | 0.78 | 0.03 | 2.18 | 1.00 | 4013.84 | 6025.11 |
| Additional Parameters | ||||||
| ar[1] | 0.37 | 0.05 | 0.86 | 1.00 | 2131.87 | 2182.06 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | 4.94 | 1.84 | 9.03 | 1.00 | 1328.46 | 1452.06 |
| sigma | NA | NA | NA | NA | NA | NA |
Report All Models Pushing Only
if (report_ordinal) {
model_rows_random_final <- model_rows_random_ordinal
model_rows_fixed_final <- model_rows_fixed_ordinal
model_rownames_fixed_final <- model_rownames_fixed_ordinal
model_rownames_random_final <- model_rownames_random_ordinal
rows_to_pack_final <- rows_to_pack_ordinal
} else {
model_rows_random_final <- model_rows_random
model_rows_fixed_final <- model_rows_fixed
model_rownames_fixed_final <- model_rownames_fixed
model_rownames_random_final <- model_rownames_random
rows_to_pack_final <- rows_to_pack
}
all_models <- report_side_by_side(
pa_sub,
pa_obj_log,
mood,
reactance,
is_reactance,
model_rows_random = model_rows_random_final,
model_rows_fixed = model_rows_fixed_final,
model_rownames_random = model_rownames_random_final,
model_rownames_fixed = model_rownames_fixed_final
) ## [1] "pa_sub"
## [1] "pa_obj_log"## [1] "mood"
## [1] "reactance"
## [1] "is_reactance"# pretty printing
summary_all_models <- all_models %>%
print_df(rows_to_pack = rows_to_pack_final) %>%
add_header_above(
c(" ", "Subjective MVPA" = 2,
"Device-Based MVPA" = 2,
"Mood" = 2,
"Reactance Gaussian" = 2,
"Reactance Dichotome" = 2)
)
export_xlsx(summary_all_models,
rows_to_pack = rows_to_pack_final,
file.path("Output", "SensitivityExcludePushing", "AllModels_onlyPushing.xlsx"),
merge_option = 'both',
simplify_2nd_row = TRUE,
colwidths = c(40, 7.4, 12.85, 7.4, 12.85,7.4, 12.85,7.4, 12.85,7.4, 12.85),
line_above_rows = c(1,2,3,21),
line_below_rows = c(-1))
summary_all_models| IRR pa_sub | 95% CI pa_sub | exp(Est.) pa_obj_log | 95% CI pa_obj_log | b mood | 95% CI mood | b reactance | 95% CI reactance | OR is_reactance | 95% CI is_reactance | |
|---|---|---|---|---|---|---|---|---|---|---|
| Intercept | 48.47* | [36.29, 64.44] | 115.12* | [101.34, 130.31] | 4.95* | [ 4.72, 5.18] | 0.43* | [ 0.15, 0.70] | 0.68 | [0.15, 2.84] |
| Within-Person Effects | ||||||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 0.99 | [ 0.90, 1.10] | 1.00 | [ 0.96, 1.03] | 0.00 | [-0.05, 0.06] | -0.01 | [-0.09, 0.08] | 0.85 | [0.39, 1.69] |
| Daily perceived pushing target -> agent | 1.00 | [ 0.90, 1.11] | 0.97 | [ 0.94, 1.01] | 0.00 | [-0.06, 0.06] | 0.14* | [ 0.05, 0.24] | 3.09* | [1.39, 10.11] |
| Day | 0.93 | [ 0.69, 1.25] | 1.16* | [ 1.02, 1.31] | 0.07 | [-0.13, 0.27] | 0.20 | [-0.19, 0.59] | 4.89 | [0.25, 135.66] |
| Daily weartime | NA | NA | 1.00 | [ 1.00, 1.00] | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.92 | [ 0.71, 1.21] | 0.96 | [ 0.85, 1.09] | 0.03 | [-0.15, 0.23] | 0.01 | [-0.24, 0.27] | 0.52 | [0.05, 4.31] |
| Mean Perceived pushing target -> agent | 1.20 | [ 0.93, 1.57] | 1.03 | [ 0.92, 1.15] | -0.11 | [-0.30, 0.07] | -0.14 | [-0.40, 0.11] | 0.46 | [0.04, 3.70] |
| Mean weartime | NA | NA | 1.00 | [ 1.00, 1.00] | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||||||
| sd(Intercept) | 0.67 | [ 0.43, 1.00] | 0.30 | [0.22, 0.40] | 0.61 | [0.47, 0.80] | 0.63 | [0.38, 0.93] | 4.64 | [2.45, 7.31] |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA | 0.15 | [0.02, 0.29] | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA | 0.08 | [0.00, 0.20] | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.13 | [ 0.01, 0.29] | 0.10 | [0.03, 0.18] | 0.07 | [0.00, 0.15] | NA | NA | 0.62 | [0.03, 1.68] |
| sd(Daily perceived pushing target -> agent) | 0.13 | [ 0.01, 0.28] | 0.05 | [0.00, 0.11] | 0.12 | [0.03, 0.23] | NA | NA | 0.78 | [0.03, 2.18] |
| Additional Parameters | ||||||||||
| ar[1] | 0.04 | [-0.93, 0.94] | 0.27 | [0.21, 0.33] | 0.27 | [0.22, 0.33] | 0.15 | [0.03, 0.28] | 0.37 | [0.05, 0.86] |
| nu | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| shape | 0.42 | [ 0.39, 0.46] | NA | NA | NA | NA | NA | NA | NA | NA |
| sderr | 0.05 | [ 0.00, 0.13] | NA | NA | NA | NA | NA | NA | 4.94 | [1.84, 9.03] |
| sigma | NA | NA | 0.53 | [0.51, 0.55] | 0.89 | [0.85, 0.92] | 1.01 | [0.94, 1.09] | NA | NA |
Analyses were conducted using the R Statistical language (version 4.4.1; R Core Team, 2024) on Windows 11 x64 (build 22635)
- Allaire J, Xie Y, Dervieux C, McPherson J, Luraschi J, Ushey K, Atkins A, Wickham H, Cheng J, Chang W, Iannone R (2024). rmarkdown: Dynamic Documents for R. R package version 2.28, https://github.com/rstudio/rmarkdown. Xie Y, Allaire J, Grolemund G (2018). R Markdown: The Definitive Guide. Chapman and Hall/CRC, Boca Raton, Florida. ISBN 9781138359338, https://bookdown.org/yihui/rmarkdown. Xie Y, Dervieux C, Riederer E (2020). R Markdown Cookbook. Chapman and Hall/CRC, Boca Raton, Florida. ISBN 9780367563837, https://bookdown.org/yihui/rmarkdown-cookbook.
- Bååth R (2024). beepr: Easily Play Notification Sounds on any Platform. R package version 2.0, https://CRAN.R-project.org/package=beepr.
- Bengtsson H (2003). “The R.oo package - Object-Oriented Programming with References Using Standard R Code.” In Hornik K, Leisch F, Zeileis A (eds.), Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003). https://www.r-project.org/conferences/DSC-2003/Proceedings/Bengtsson.pdf.
- Bengtsson H (2003). “The R.oo package - Object-Oriented Programming with References Using Standard R Code.” In Hornik K, Leisch F, Zeileis A (eds.), Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003). https://www.r-project.org/conferences/DSC-2003/Proceedings/Bengtsson.pdf.
- Bengtsson H (2023). R.utils: Various Programming Utilities. R package version 2.12.3, https://CRAN.R-project.org/package=R.utils.
- Bürkner P (2017). “brms: An R Package for Bayesian Multilevel Models Using Stan.” Journal of Statistical Software, 80(1), 1-28. doi:10.18637/jss.v080.i01 https://doi.org/10.18637/jss.v080.i01. Bürkner P (2018). “Advanced Bayesian Multilevel Modeling with the R Package brms.” The R Journal, 10(1), 395-411. doi:10.32614/RJ-2018-017 https://doi.org/10.32614/RJ-2018-017. Bürkner P (2021). “Bayesian Item Response Modeling in R with brms and Stan.” Journal of Statistical Software, 100(5), 1-54. doi:10.18637/jss.v100.i05 https://doi.org/10.18637/jss.v100.i05.
- Eddelbuettel D, Francois R, Allaire J, Ushey K, Kou Q, Russell N, Ucar I, Bates D, Chambers J (2024). Rcpp: Seamless R and C++ Integration. R package version 1.0.13, https://CRAN.R-project.org/package=Rcpp. Eddelbuettel D, François R (2011). “Rcpp: Seamless R and C++ Integration.” Journal of Statistical Software, 40(8), 1-18. doi:10.18637/jss.v040.i08 https://doi.org/10.18637/jss.v040.i08. Eddelbuettel D (2013). Seamless R and C++ Integration with Rcpp. Springer, New York. doi:10.1007/978-1-4614-6868-4 https://doi.org/10.1007/978-1-4614-6868-4, ISBN 978-1-4614-6867-7. Eddelbuettel D, Balamuta J (2018). “Extending R with C++: A Brief Introduction to Rcpp.” The American Statistician, 72(1), 28-36. doi:10.1080/00031305.2017.1375990 https://doi.org/10.1080/00031305.2017.1375990.
- Gabry J, Mahr T (2024). “bayesplot: Plotting for Bayesian Models.” R package version 1.11.1, https://mc-stan.org/bayesplot/. Gabry J, Simpson D, Vehtari A, Betancourt M, Gelman A (2019). “Visualization in Bayesian workflow.” J. R. Stat. Soc. A, 182, 389-402. doi:10.1111/rssa.12378 https://doi.org/10.1111/rssa.12378.
- Grolemund G, Wickham H (2011). “Dates and Times Made Easy with lubridate.” Journal of Statistical Software, 40(3), 1-25. https://www.jstatsoft.org/v40/i03/.
- Hester J, Wickham H, Csárdi G (2024). fs: Cross-Platform File System Operations Based on ‘libuv’. R package version 1.6.4, https://CRAN.R-project.org/package=fs.
- Küng P (2023). wbCorr: Bivariate Within- and Between-Cluster Correlations. University of Zürich. R package version 0.1.22. https://github.com/Pascal-Kueng/wbCorr.
- Müller K, Wickham H (2023). tibble: Simple Data Frames. R package version 3.2.1, https://CRAN.R-project.org/package=tibble.
- R Core Team (2024). R: A Language and Environment for Statistical Computing. R Foundation for Statistical Computing, Vienna, Austria. https://www.R-project.org/.
- Schauberger P, Walker A (2024). openxlsx: Read, Write and Edit xlsx Files. R package version 4.2.7.1, https://CRAN.R-project.org/package=openxlsx.
- Wickham H (2016). ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York. ISBN 978-3-319-24277-4, https://ggplot2.tidyverse.org.
- Wickham H (2023). forcats: Tools for Working with Categorical Variables (Factors). R package version 1.0.0, https://CRAN.R-project.org/package=forcats.
- Wickham H (2023). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.5.1, https://CRAN.R-project.org/package=stringr.
- Wickham H (2024). rvest: Easily Harvest (Scrape) Web Pages. R package version 1.0.4, https://CRAN.R-project.org/package=rvest.
- Wickham H, Averick M, Bryan J, Chang W, McGowan LD, François R, Grolemund G, Hayes A, Henry L, Hester J, Kuhn M, Pedersen TL, Miller E, Bache SM, Müller K, Ooms J, Robinson D, Seidel DP, Spinu V, Takahashi K, Vaughan D, Wilke C, Woo K, Yutani H (2019). “Welcome to the tidyverse.” Journal of Open Source Software, 4(43), 1686. doi:10.21105/joss.01686 https://doi.org/10.21105/joss.01686.
- Wickham H, Bryan J (2023). readxl: Read Excel Files. R package version 1.4.3, https://CRAN.R-project.org/package=readxl.
- Wickham H, François R, Henry L, Müller K, Vaughan D (2023). dplyr: A Grammar of Data Manipulation. R package version 1.1.4, https://CRAN.R-project.org/package=dplyr.
- Wickham H, Henry L (2023). purrr: Functional Programming Tools. R package version 1.0.2, https://CRAN.R-project.org/package=purrr.
- Wickham H, Hester J, Bryan J (2024). readr: Read Rectangular Text Data. R package version 2.1.5, https://CRAN.R-project.org/package=readr.
- Wickham H, Hester J, Ooms J (2023). xml2: Parse XML. R package version 1.3.6, https://CRAN.R-project.org/package=xml2.
- Wickham H, Vaughan D, Girlich M (2024). tidyr: Tidy Messy Data. R package version 1.3.1, https://CRAN.R-project.org/package=tidyr.
- Xie Y (2024). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.48, https://yihui.org/knitr/. Xie Y (2015). Dynamic Documents with R and knitr, 2nd edition. Chapman and Hall/CRC, Boca Raton, Florida. ISBN 978-1498716963, https://yihui.org/knitr/. Xie Y (2014). “knitr: A Comprehensive Tool for Reproducible Research in R.” In Stodden V, Leisch F, Peng RD (eds.), Implementing Reproducible Computational Research. Chapman and Hall/CRC. ISBN 978-1466561595.
- Zhu H (2024). kableExtra: Construct Complex Table with ‘kable’ and Pipe Syntax. R package version 1.4.0, https://CRAN.R-project.org/package=kableExtra.